home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok77.lha / Funktionen / FunktionenPost.mod < prev    next >
Text File  |  1993-08-15  |  8KB  |  251 lines
  1. (****************************************************************************
  2. :Program.       FunktionenPost.mod
  3. :Contents.      floating-point arithmetic compiler with postscript output
  4. :Author.        Richard Günther [gvm]
  5. :Address.       HeilbronnerStr.267, 7410 Reutlingen
  6. :Phone.         07121/66432
  7. :Copyright.     Public Domain
  8. :Language.      Oberon
  9. :Translator.    AmigaOberon v2.14d
  10. :History.       V1.0 [gvm] 04-July-92  first implementation
  11. :Bugs.          none known
  12. ****************************************************************************)
  13.  
  14. (* Compiler Grammar:
  15.       Ausdruck  = Summe.
  16.       Summe     = Produkt {("+"|"-") Produkt}.
  17.       Produkt   = Potenz {("*"|"/") Potenz}.
  18.       Potenz    = Faktor {"^" Faktor}.
  19.       Faktor    = ["+"|"-"](("(" Summe ")")|
  20.                             (Funktion "(" Summe ")")|
  21.                             Variable | Zahl | "pi" | "e").
  22.       Funktion  = "SIN" | "COS" | "TAN" |....
  23.       Zahl      = Ziffern["." Ziffern]["E"["+"|"-"] Ziffern].
  24.       Ziffern   = Ziffer {Ziffer}.
  25.       Variable  = CHAR.  *)
  26.  
  27. MODULE FunktionenPost ;
  28.  
  29. IMPORT  S   : SYSTEM,
  30.         O   : OberonLib,
  31.         E   : Exec,
  32.         ST  : Strings,
  33.         LRC : LongRealConversions ;
  34.  
  35.  
  36. CONST Defs = "/e{2.718281828}def /pi{3.141592654}def /grad{57.29577951 mul}def /rad{0.01745329252 mul}def\n" ;
  37.  
  38. TYPE  Func      = STRUCT
  39.                     name      : ARRAY 8 OF CHAR ;
  40.                     code      : ARRAY 120 OF CHAR ;
  41.                   END ;
  42.       FArrayTyp = ARRAY 15 OF Func ;
  43. CONST FArray  = FArrayTyp("ABS","abs\n",
  44.                           "ACOS","dup dup mul 1 exch sub sqrt div atan rad\n",
  45.                           "ASIN","dup dup mul 1 exch sub sqrt exch div atan rad\n",
  46.                           "ATAN","atan rad\n",
  47.                           "COS","grad cos\n",
  48.                           "COSH","dup e exch exp exch neg e exch exp add 2 div\n",
  49.                           "EXP","e exch exp\n",
  50.                           "LN","ln\n",
  51.                           "LOG","log\n",
  52.                           "SIN","grad sin\n",
  53.                           "SINH","dup e exch exp exch neg e exch exp sub 2 div\n",
  54.                           "SQRT","sqrt\n",
  55.                           "TAN","dup grad sin exch grad cos div\n",
  56.                           "TANH","dup dup e exch exp exch neg e exch exp sub exch dup e exch exp exch neg e exch exp add div\n",
  57.                           "",""
  58.                          ) ;
  59.  
  60.  
  61. PROCEDURE Compile*(     source    : ARRAY OF CHAR ;
  62.                         vars      : ARRAY OF CHAR ;   (* z.B. "xy" *)
  63.                         funcName  : ARRAY OF CHAR ;
  64.                    VAR  code      : ARRAY OF CHAR ;
  65.                    VAR  errpos    : INTEGER): BOOLEAN ;
  66. VAR pos,len       : INTEGER ;
  67.     cLen,maxCLen  : INTEGER ;
  68.     numVars       : INTEGER ;
  69.     i             : INTEGER ;
  70.     notEmpty      : BOOLEAN ;
  71.  
  72.   PROCEDURE PutChar(char : CHAR): BOOLEAN ;
  73.   BEGIN
  74.     INC(cLen,1) ;
  75.     IF cLen>=maxCLen THEN errpos:=-2 ; RETURN TRUE END ;
  76.     ST.AppendChar(code,char) ;
  77.     notEmpty:=TRUE ; RETURN FALSE ;
  78.   END PutChar ;
  79.  
  80.   (* $CopyArrays- *)
  81.   PROCEDURE Put(string  : ARRAY OF CHAR): BOOLEAN ;
  82.   BEGIN
  83.     INC(cLen,ST.Length(string)) ;
  84.     IF cLen>=maxCLen THEN errpos:=-2 ; RETURN TRUE END ;
  85.     ST.Append(code,string) ;
  86.     notEmpty:=TRUE ; RETURN FALSE ;
  87.   END Put ;
  88.  
  89.  
  90.   PROCEDURE Fehler ;
  91.   BEGIN
  92.     IF errpos=-1 THEN errpos:=pos ; pos:=256 END ;
  93.   END Fehler ;
  94.   PROCEDURE Match(c : CHAR):BOOLEAN ;
  95.   BEGIN
  96.     IF source[pos]=c THEN INC(pos) ; RETURN FALSE
  97.                      ELSE Fehler ; RETURN TRUE
  98.     END ;
  99.   END Match ;
  100.   PROCEDURE SkipBlanks ;
  101.   BEGIN
  102.     WHILE (pos<=len) AND (source[pos]=" ") DO INC(pos) END ;
  103.   END SkipBlanks ;
  104.  
  105.   PROCEDURE ^Summe(): BOOLEAN ;
  106.  
  107.   PROCEDURE ReadZiffern():BOOLEAN ;
  108.   BEGIN
  109.     IF (pos>len) OR ((source[pos]<"0") OR (source[pos]>"9")) THEN
  110.       Fehler ; RETURN TRUE END ;
  111.     WHILE (pos<=len) AND ((source[pos]>="0") AND (source[pos]<="9")) DO
  112.       INC(pos) END ;
  113.     RETURN FALSE ;
  114.   END ReadZiffern ;
  115.   PROCEDURE Zahl(negativ: BOOLEAN): BOOLEAN ;
  116.   VAR start: INTEGER ;
  117.       buf : ARRAY 32 OF CHAR ;
  118.       lr: LONGREAL ;
  119.   BEGIN
  120.     start:=pos ;
  121.     IF ReadZiffern() THEN RETURN TRUE END ;
  122.     IF (pos<=len) AND (source[pos]=".") THEN
  123.       INC(pos) ; IF ReadZiffern() THEN RETURN TRUE END ;
  124.     END ;
  125.     IF (pos<=len) AND (source[pos]="E") THEN
  126.       INC(pos) ;
  127.       IF (pos<=len) AND ((source[pos]="+") OR (source[pos]="-")) THEN
  128.         INC(pos) ; END ;
  129.       IF ReadZiffern() THEN RETURN TRUE END ;
  130.     END ;
  131.     IF negativ THEN DEC(start) END ;
  132.     ST.Cut(source,start,pos-start,buf) ;
  133.     IF ~LRC.StringToReal(buf,lr)
  134.        OR Put(buf) OR Put(" ") THEN RETURN TRUE END ;
  135.     RETURN FALSE
  136.   END Zahl ;
  137.  
  138.   PROCEDURE Faktor():BOOLEAN ;
  139.   VAR negieren  : BOOLEAN ;
  140.       token     : ARRAY 8 OF CHAR ;
  141.       tpos      : INTEGER ;
  142.   BEGIN
  143.     SkipBlanks ;
  144.     negieren:=(pos<=len) AND (source[pos]="-") ;
  145.     IF (pos<=len) AND ((source[pos]="+") OR (source[pos]="-")) THEN
  146.       INC(pos)
  147.     END ;
  148.     IF (pos<=len) THEN
  149.       CASE source[pos] OF
  150.         "0".."9": IF Zahl(negieren) THEN RETURN TRUE END ;
  151.                   negieren:=FALSE |
  152.              "(": INC(pos) ;
  153.                   IF Summe() OR Match(")") THEN RETURN TRUE END |
  154.       ELSE
  155.         tpos:=0 ;
  156.         WHILE (source[pos]>="A") AND (source[pos]<="Z") DO
  157.           token[tpos]:=source[pos] ; INC(tpos) ; INC(pos) ;
  158.         END ;
  159.         token[tpos]:=CHR(0) ;
  160.         tpos:=0 ;
  161.         LOOP
  162.           WHILE FArray[tpos].name#"" DO
  163.             IF token=FArray[tpos].name THEN
  164.               IF Match("(")  OR  Summe()  OR  Match(")")
  165.                  OR Put(FArray[tpos].code) THEN RETURN TRUE END ;
  166.               EXIT ;
  167.             END ;
  168.             INC(tpos) ;
  169.           END ;
  170.           IF    token="PI" THEN IF Put("pi ") THEN RETURN TRUE END ;
  171.           ELSIF token="E" THEN IF Put("e ") THEN RETURN TRUE END ;
  172.           ELSIF token[1]=CHR(0) THEN
  173.             tpos:=0 ;
  174.             WHILE tpos#numVars DO
  175.               IF vars[tpos]=token[0] THEN
  176.                 IF PutChar(vars[tpos]) OR Put(" ") THEN RETURN TRUE END ;
  177.                 EXIT ;
  178.               END ;
  179.               INC(tpos) ;
  180.             END ;
  181.             Fehler ;
  182.           ELSE Fehler ; RETURN TRUE
  183.           END ;
  184.           EXIT ;
  185.         END ;
  186.       END ;
  187.     END ;
  188.     IF negieren THEN IF Put("neg ") THEN RETURN TRUE END ;
  189.     END ;
  190.     SkipBlanks ;
  191.     RETURN FALSE ;
  192.   END Faktor ;
  193.  
  194.   PROCEDURE Potenz(): BOOLEAN ;
  195.   BEGIN
  196.     IF Faktor() THEN RETURN TRUE END ;
  197.     WHILE (pos<=len) AND (source[pos]="^") DO
  198.       INC(pos) ;
  199.       IF Faktor() OR Put("exp ") THEN RETURN TRUE END ;
  200.     END ;
  201.     RETURN FALSE ;
  202.   END Potenz ;
  203.  
  204.   PROCEDURE Produkt(): BOOLEAN ;
  205.   VAR ch  : CHAR ;
  206.   BEGIN
  207.     IF Potenz() THEN RETURN TRUE END ;
  208.     WHILE (pos<=len) AND ((source[pos]="*") OR (source[pos]="/")) DO
  209.       ch:=source[pos] ; INC(pos) ;
  210.       IF Potenz() THEN RETURN TRUE END ;
  211.       IF ch="*" THEN IF Put("mul ") THEN RETURN TRUE END ;
  212.                 ELSE IF Put("div ") THEN RETURN TRUE END ;
  213.       END ;
  214.     END ;
  215.     RETURN FALSE ;
  216.   END Produkt ;
  217.  
  218.   PROCEDURE Summe(): BOOLEAN ;
  219.   VAR ch  : CHAR ;
  220.   BEGIN
  221.     IF Produkt() THEN RETURN TRUE END ;
  222.     WHILE (pos<=len) AND ((source[pos]="+") OR (source[pos]="-")) DO
  223.       ch:=source[pos] ; INC(pos) ;
  224.       IF Produkt() THEN RETURN TRUE END ;
  225.       IF ch="+" THEN IF Put("add\n") THEN RETURN TRUE END ;
  226.                 ELSE IF Put("sub\n") THEN RETURN TRUE END ;
  227.       END ;
  228.     END ;
  229.   END Summe ;
  230.  
  231. BEGIN
  232.   ST.Upper(source) ; len:=ST.Length(source) ;
  233.   ST.Upper(vars) ; numVars:=ST.Length(vars) ;
  234.   maxCLen:=LEN(code) ; cLen:=0 ; code:="" ;
  235.   IF len=0 THEN RETURN FALSE END ;
  236.   pos:=0 ; errpos:=-1 ;
  237.   IF Put("/") OR Put(funcName) OR Put("{\n")
  238.      OR Put(Defs) THEN RETURN FALSE END ;
  239.   i:=numVars-1 ;
  240.   WHILE i>-1 DO
  241.     IF Put("/") OR PutChar(vars[i]) OR Put(" exch def\n") THEN RETURN FALSE END ;
  242.     DEC(i) ;
  243.   END ;
  244.   notEmpty:=FALSE ;
  245.   IF Summe() OR ~notEmpty OR Put("} def\n") THEN RETURN FALSE END ;
  246.   RETURN TRUE ;
  247. END Compile ;
  248.  
  249.  
  250. END FunktionenPost.
  251.